home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / newsgrp / group92c.txt / 000017_icon-group-sender _Mon Oct 12 17:36:04 1992.msg < prev    next >
Internet Message Format  |  1993-01-04  |  24KB
  1. Received: by cheltenham.cs.arizona.edu; Wed, 14 Oct 1992 04:08:19 MST
  2. Date: 12 Oct 92 17:36:04 GMT
  3. From: cis.ohio-state.edu!pacific.mps.ohio-state.edu!linac!uchinews!ellis!goer@ucbvax.Berkeley.EDU  (Richard L. Goerwitz)
  4. Organization: University of Chicago Computing Organizations
  5. Subject: Re: confusing errors
  6. Message-Id: <1992Oct12.173604.3765@midway.uchicago.edu>
  7. References: <1992Oct12.140817.25199@midway.uchicago.edu>
  8. Sender: icon-group-request@cs.arizona.edu
  9. To: icon-group@cs.arizona.edu
  10. Status: R
  11. Errors-To: icon-group-errors@cs.arizona.edu
  12.  
  13. Not so confusing after all, actually.
  14.  
  15. I just realized that "link," "global," etc. are not "beginners."  That is,
  16. they don't trigger semicolon insertion after a preceding complete expres-
  17. sion.  They don't need to.  Hence
  18.  
  19.     global hi procedure main(); end
  20.  
  21. is a perfectly valid Icon program.
  22.  
  23. If anybody find the Icon tokenizer interesting (automatic semicolon inser-
  24. tion is really a great idea - why don't all languages do it?), then here's
  25. a fun program.  Those with some savvy will recognize at once how this sort
  26. of thing could be useful for anyone implementing an Icon preprocessor or
  27. file compressor.  Of course there are bugs.  It was just written, and I've
  28. only tried it on a few files:
  29.  
  30. global next_c
  31. record TOK(sym, str)
  32.  
  33. procedure main()
  34.  
  35.     local separator
  36.     separator := ""
  37.     every T := \iparse_tokens(&input) do {
  38.  
  39.     if any(&digits ++ &letters ++ "._", (\T.str)[1]) &
  40.            \T.sym ~== "DOT"
  41.         then writes(separator)
  42.  
  43.     writes(T.str)
  44.     
  45.         if any(&digits ++ &letters ++ "_.", (\T.str)[-1]) &
  46.            \T.sym ~== "DOT"
  47.     then separator := " " else separator := ""
  48.     }
  49.  
  50. end
  51.  
  52.  
  53. procedure iparse_tokens(stream, getchar)
  54.  
  55.     local elem, whitespace, token, primitives, reserveds
  56.     static be_tbl, reserved_tbl, operators
  57.     initial {
  58.  
  59.     #  Primitive Tokens
  60.     #
  61.     primitives := [
  62.                ["identifier",      "IDENT",     "be"],
  63.                ["integer-literal", "INTLIT",    "be"],
  64.                ["real-literal",    "REALLIT",   "be"],
  65.                ["string-literal",  "STRINGLIT", "be"],
  66.                ["cset-literal",    "CSETLIT",   "be"],
  67.                ["end-of-file",     "EOFX",      "" ]]
  68.  
  69.     # Reserved Words
  70.     #
  71.     reserveds  := [
  72.                ["break",           "BREAK",     "be"],
  73.                ["by",              "BY",        ""  ],
  74.                ["case",            "CASE",      "b" ],
  75.                ["create",          "CREATE",    "b" ],
  76.                ["default",         "DEFAULT",   "b" ],
  77.                ["do",              "DO",        ""  ],
  78.                        ["else",            "ELSE",      ""  ],
  79.                ["end",             "END",       "b" ],
  80.                ["every",           "EVERY",     "b" ],
  81.                ["fail",            "FAIL",      "be"],
  82.                ["global",          "GLOBAL",    ""  ],
  83.                ["if",              "IF",        "b" ],
  84.                ["initial",         "INITIAL",   "b" ],
  85.                ["invocable",       "INVOCABLE", ""  ],
  86.                ["link",            "LINK",      ""  ],
  87.                ["local",           "LOCAL",     "b" ],
  88.                ["next",            "NEXT",      "be"],
  89.                ["not",             "NOT",       "b" ],
  90.                ["of",              "OF",        ""  ],
  91.                ["procedure",       "PROCEDURE", ""  ],
  92.                ["record",          "RECORD",    ""  ],
  93.                ["repeat",          "REPEAT",    "b" ],
  94.                ["return",          "RETURN",    "be"],
  95.                ["static",          "STATIC",    "b" ],
  96.                ["suspend",         "SUSPEND",   "be"],
  97.                ["then",            "THEN",      ""  ],
  98.                ["to",              "TO",        ""  ],
  99.                ["until",           "UNTIL",     "b" ],
  100.                ["while",           "WHILE",     "b" ]]
  101.  
  102.     # Operators
  103.     #
  104.     operators  := [
  105.                [":=",              "ASSIGN",    ""  ],
  106.                ["@",               "AT",        "b" ],
  107.                ["@:=",             "AUGACT",    ""  ],
  108.                ["&:=",             "AUGAND",    ""  ],
  109.                ["=:=",             "AUGEQ",     ""  ],
  110.                ["===:=",           "AUGEQV",    ""  ],
  111.                [">=:=",            "AUGGE",     ""  ],
  112.                [">:=",             "AUGGT",     ""  ],
  113.                ["<=:=",            "AUGLE",     ""  ],
  114.                ["<:=",             "AUGLT",     ""  ],
  115.                ["~=:=",            "AUGNE",     ""  ],
  116.                ["~===:=",          "AUGNEQV",   ""  ],
  117.                ["==:=",            "AUGSEQ",    ""  ],
  118.                [">>=:=",           "AUGSGE",    ""  ],
  119.                [">>:=",            "AUGSGT",    ""  ],
  120.                ["<<=:=",           "AUGSLE",    ""  ],
  121.                ["<<:=",            "AUGSLT",    ""  ],
  122.                ["~==:=",           "AUGSNE",    ""  ],
  123.                ["\\",              "BACKSLASH", "b" ],
  124.                ["!",               "BANG",      "b" ],
  125.                ["|",               "BAR",       "b" ],
  126.                ["^",               "CARET",     "b" ],
  127.                ["^:=",             "CARETASGN", "b" ],
  128.                [":",               "COLON",     ""  ],
  129.                [",",               "COMMA",     ""  ],
  130.                ["||",              "CONCAT",    "b" ],
  131.                        ["||:=",            "CONCATASGN",""  ],
  132.                ["&",               "CONJUNC",   "b" ],
  133.                [".",               "DOT",       "b" ],
  134.                ["--",              "DIFF",      "b" ],
  135.                ["--:=",            "DIFFASGN",  ""  ],
  136.                ["===",             "EQUIV",     "b" ],
  137.                ["**",              "INTER",     "b" ],
  138.                ["**:=",            "INTERASGN", ""  ],
  139.                ["{",               "LBRACE",    "b" ],
  140.                ["[",               "LBRACK",    "b" ],
  141.                ["|||",             "LCONCAT",   "b" ],
  142.                ["|||:=",           "LCONCATASGN","" ],
  143.                ["==",              "LEXEQ",     "b" ],
  144.                [">>=",             "LEXGE",     ""  ],
  145.                [">>",              "LEXGT",     ""  ],
  146.                ["<<=",             "LEXLE",     ""  ],
  147.                ["<<",              "LEXLT",     ""  ],
  148.                ["~==",             "LEXNE",     "b" ],
  149.                ["(",               "LPAREN",    "b" ],
  150.                ["-:",              "MCOLON",    ""  ],
  151.                ["-",               "MINUS",     "b" ],
  152.                ["-:=",             "MINUSASGN", ""  ],
  153.                ["%",               "MOD",       ""  ],
  154.                ["%:=",             "MODASGN",   ""  ],
  155.                ["~===",            "NOTEQUIV",  "b" ],
  156.                ["=",               "NUMEQ",     "b" ],
  157.                [">=",              "NUMGE",     ""  ],
  158.                [">",               "NUMGT",     ""  ],
  159.                ["<=",              "NUMLE",     ""  ],
  160.                ["<",               "NUMLT",     ""  ],
  161.                ["~=",              "NUMNE",     "b" ],
  162.                ["+:",              "PCOLON",    ""  ],
  163.                ["+",               "PLUS",      "b" ],
  164.                ["+:=",             "PLUSASGN",  ""  ],
  165.                ["?",               "QMARK",     "b" ],
  166.                ["<-",              "REVASSIGN", ""  ],
  167.                ["<->",             "REVSWAP",   ""  ],
  168.                ["}",               "RBRACE",    "e" ],
  169.                ["]",               "RBRACK",    "e" ],
  170.                [")",               "RPAREN",    "e" ],
  171.                [";",               "SEMICOL",   ""  ],
  172.                ["?:=",             "SCANASGN",  ""  ],
  173.                ["/",               "SLASH",     "b" ],
  174.                ["/:=",             "SLASHASGN", ""  ],
  175.                ["*",               "STAR",      "b" ],
  176.                ["*:=",             "STARASGN",  ""  ],
  177.                [":=:",             "SWAP",      ""  ],
  178.                ["~",               "TILDE",     "b" ],
  179.                ["++",              "UNION",     "b" ],
  180.                ["++:=",            "UNIONASGN", ""  ],
  181.                ["$(",              "LBRACE",    "b" ],
  182.                ["$)",              "RBRACE",    "e" ],
  183.                ["$<",              "LBRACK",    "b" ],
  184.                ["$>",              "RBRACK",    "e" ]]
  185.  
  186.     # static be_tbl, reserved_tbl
  187.     reserved_tbl := table()
  188.     every elem := !reserveds do
  189.         insert(reserved_tbl, elem[1], elem[2])
  190.     be_tbl := table()
  191.     every elem := !primitives | !reserveds | !operators do {
  192.         insert(be_tbl, elem[2], elem[3])
  193.     }
  194.     }
  195.  
  196.     /getchar   := create ! (!stream || "\n")
  197.     whitespace := ' \t'
  198.     /next_c    := @getchar
  199.  
  200.     repeat {
  201.     case next_c of {
  202.  
  203.         "."      : {
  204.         # Could be a real literal *or* a dot operator.  Check
  205.         # following character to see if it's a digit.  If so,
  206.         # it's a real literal.  We can only get away with
  207.         # doing the dot here because it is not a substring of
  208.         # any longer identifier.  If this gets changed, we'll
  209.         # have to move this code into do_operator().
  210.         #
  211.         last_token := do_dot(getchar)
  212.         suspend last_token
  213. #        write(&errout, "next_c == ", image(next_c))
  214.         next
  215.         }
  216.  
  217.         "\n"     : {
  218.         # If do_newline fails, it means we're at the end of
  219.         # the input stream, and we should break out of the
  220.         # repeat loop.
  221.         #
  222.         every last_token := do_newline(getchar, last_token, be_tbl)
  223.         do suspend last_token
  224.         if next_c === &null then break
  225.         next
  226.         }
  227.  
  228.         "\#"     : {
  229.         # Just a comment.  Strip it by reading every character
  230.         # up to the next newline.  The global var next_c
  231.         # should *always* == "\n" when this is done.
  232.         #
  233.         do_number_sign(getchar)
  234. #        write(&errout, "next_c == ", image(next_c))
  235.         next
  236.         }
  237.  
  238.         "\""    : {
  239.         # Suspend as STRINGLIT everything from here up to the
  240.         # next non-backslashed quotation mark, inclusive
  241.         # (accounting for the _ line-continuation convention).
  242.         #
  243.         last_token := do_quotation_mark(getchar)
  244.         suspend last_token
  245. #        write(&errout, "next_c == ", image(next_c))
  246.         next
  247.         }
  248.  
  249.         "'"     : {
  250.         # Suspend as CSETLIT everything from here up to the
  251.         # next non-backslashed apostrophe, inclusive.
  252.         #
  253.         last_token := do_apostrophe(getchar)
  254.         suspend last_token
  255. #        write(&errout, "next_c == ", image(next_c))
  256.         next
  257.         }
  258.  
  259.         default : {
  260.         # If we get to here, we have either whitespace, an
  261.         # integer or real literal, an identifier or reserved
  262.         # word (both get handled by do_identifier), or an
  263.         # operator.  The question of which we have can be
  264.         # determined largely just by checking the first
  265.         # character.  Whitespace begins with whitespace;
  266.         # integer or real literals with digits, identifiers
  267.         # and reserved words with underscores or letters, and
  268.         # operators begin with everything not covered above.
  269.         #
  270.         if any(whitespace, next_c) then {
  271.             # Like all of the TOK forming procedures,
  272.             # do_whitespace resets next_c.
  273.             do_whitespace(getchar, whitespace)
  274.             # don't suspend any tokens
  275.             next
  276.         }
  277.         if any(&digits, next_c) then {
  278.             last_token := do_digits(getchar)
  279.             suspend last_token
  280.             next
  281.         }
  282.         if any(&letters ++ '_', next_c) then {
  283.             last_token := do_identifier(getchar, reserved_tbl)
  284.             suspend last_token
  285.             next
  286.         }
  287. #        write(&errout, "it's an operator")
  288.         last_token := do_operator(getchar, operators)
  289.         suspend last_token
  290.         next
  291.         }
  292.     }
  293.     }
  294.  
  295.     # If stream argument is nonnull, then we are in the top-level
  296.     # iparse_tokens().  If not, then we are in a recursive call, and
  297.     # we should not emit all this end-of-file crap.
  298.     #
  299.     if \stream then {
  300.     suspend TOK("EOFX")
  301.     return TOK("$")
  302.     }
  303.     else fail
  304.  
  305. end
  306.  
  307.  
  308. #
  309. #  do_dot:  coexpression -> TOK record
  310. #           getchar      -> t
  311. #
  312. #      Where getchar is the coexpression that produces the next
  313. #      character from the input stream and t is a token record whose
  314. #      sym field contains either "REALLIT" or "DOT".  Essentially,
  315. #      do_dot checks the next char on the input stream to see if it's
  316. #      an integer.  Since the preceding char was a dot, an integer
  317. #      tips us off that we have a real literal.  Otherwise, it's just
  318. #      a dot operator.  Note that do_dot resets next_c for the next
  319. #      cycle through the main case loop in the calling procedure.
  320. #
  321. procedure do_dot(getchar)
  322.  
  323.     local token
  324.     # global next_c
  325.  
  326. #    write(&errout, "it's a dot")
  327.  
  328.     # If dot's followed by a digit, then we have a real literal.
  329.     #
  330.     if any(&digits, next_c := @getchar) then {
  331. #    write(&errout, "dot -> it's a real literal")
  332.     token := "." || next_c
  333.     while any(&digits, next_c := @getchar) do
  334.         token ||:= next_c
  335.     if token ||:= (next_c == ("e"|"E")) then {
  336.         while (next_c := @getchar) == "0"
  337.         while any(&digits, next_c) do {
  338.         token ||:= next_c
  339.         next_c = @getchar
  340.         }
  341.     }
  342.     return TOK("REALLIT", token)
  343.     }
  344.  
  345.     # Dot not followed by an integer; so we just have a dot operator,
  346.     # and not a real literal.
  347.     #
  348. #    write(&errout, "dot -> just a plain dot")
  349.     return TOK("DOT", ".")
  350.     
  351. end
  352.  
  353.  
  354. #
  355. #  do_newline:  coexpression x TOK record x table -> TOK records
  356. #               (getchar, last_token, be_tbl)     -> Ts (a generator)
  357. #
  358. #      Where getchar is the coexpression that returns the next
  359. #      character from the input stream, last_token is the last TOK
  360. #      record suspended by the calling procedure, be_tbl is a table of
  361. #      tokens and their "beginner/ender" status, and Ts are TOK
  362. #      records.  Note that do_newline resets next_c.  Do_newline is a
  363. #      mess.  What it does is check the last token suspended by the
  364. #      calling procedure to see if it was a beginner or ender.  It
  365. #      then gets the next token by calling iparse_tokens again.  If
  366. #      the next token is a beginner and the last token is an ender,
  367. #      then we have to suspend a SEMICOL token.  In either event, both
  368. #      the last and next token are suspended.
  369. #
  370. procedure do_newline(getchar, last_token, be_tbl)
  371.  
  372.     local next_token
  373.     # global next_c
  374.  
  375. #    write(&errout, "it's a newline")
  376.  
  377.     # Go past any additional newlines.
  378.     #
  379.     while next_c == "\n" do {
  380.         # NL can be the last char in the getchar stream; if it *is*,
  381.     # then signal that it's time to break out of the repeat loop
  382.     # in the calling procedure.
  383.     #
  384.     next_c := @getchar | {
  385.         next_c := &null
  386.         fail
  387.     }
  388.     }
  389.  
  390.     # If there was a last token (i.e. if a newline wasn't the first
  391.     # character of significance in the input stream), then check to
  392.     # see if it was an ender.  If so, then check to see if the next
  393.     # token is a beginner.  If so, then suspend a TOK("SEMICOL",";")
  394.     # record before suspending the next token.
  395.     #
  396.     if find("e", be_tbl[(\last_token).sym]) then {
  397. #    write(&errout, "calling iparse_tokens via do_newline")
  398. #    &trace := -1
  399.     if next_token := iparse_tokens(stream, getchar)
  400.     then {
  401. #        write(&errout, "call of iparse_tokens via do_newline yields ",
  402. #          ximage(next_token))
  403.         if find("b", be_tbl[next_token.sym])
  404.         then suspend TOK("SEMICOL", ";")
  405.         suspend next_token
  406.     }
  407.     else {
  408. #        &trace := 0
  409.         fail
  410.     }
  411.     }
  412.  #   &trace := 0
  413.  
  414. end
  415.  
  416.  
  417. #
  418. #  do_number_sign:  coexpression -> &null
  419. #                   getchar      -> 
  420. #
  421. #      Where getchar is the coexpression that pops characters off the
  422. #      main input stream.  Sets the global variable next_c.  This
  423. #      procedure simply reads characters until it gets a newline, then
  424. #      returns with next_c == "\n".  Since the preceding character was
  425. #      a number sign, this has the effect of stripping comments.
  426. #
  427. procedure do_number_sign(getchar)
  428.  
  429.     # global next_c
  430.  
  431. #    write(&errout, "it's a number sign")
  432.     while next_c ~== "\n" do {
  433.         # NL can be the last char in the getchar stream; if it *is*,
  434.         # then break out of the repeat loop
  435.     next_c := @getchar | fail
  436.     }
  437.  
  438.     # Return to calling procedure to cycle around again with the new
  439.     # next_c already set.  Next_c should always be "\n" at this point.
  440.     return
  441.  
  442. end
  443.  
  444.  
  445. #
  446. #  do_quotation_mark:  coexpression -> TOK record
  447. #                      getchar      -> t
  448. #
  449. #      Where getchar is the coexpression that yields another character
  450. #      from the input stream, and t is a TOK record with "STRINGLIT"
  451. #      as its sym field.  Puts everything upto and including the next
  452. #      non-backslashed quotation mark into the str field.  Handles the
  453. #      underscore continuation convention.
  454. #
  455. procedure do_quotation_mark(getchar)
  456.  
  457.     local token
  458.     # global next_c
  459.  
  460.     # write(&errout, "it's a string literal")
  461.     token := "\""
  462.     while next_c := @getchar do {
  463.     if next_c == "\n" & token[-1] == "_" then {
  464.         token := token[1:-1]
  465.         next
  466.     } else {
  467.         if slashupto("\"", token ||:= next_c, 2)
  468.         then {
  469.         next_c := @getchar
  470.         # resume outermost (repeat) loop in calling procedure,
  471.         # with the new (here explicitly set) next_c
  472.         return TOK("STRINGLIT", token)
  473.         }
  474.     }
  475.     }
  476.  
  477. end
  478.  
  479.  
  480. #
  481. #  do_apostrophe:  coexpression -> TOK record
  482. #                  getchar      -> t
  483. #
  484. #      Where getchar is the coexpression that yields another character
  485. #      from the input stream, and t is a TOK record with "CSETLIT"
  486. #      as its sym field.  Puts everything upto and including the next
  487. #      non-backslashed apostrope into the str field.
  488. #
  489. procedure do_apostrophe(getchar)
  490.  
  491.     local token
  492.     # global next_c
  493.  
  494. #   write(&errout, "it's a cset literal")
  495.     token := "'"
  496.     while next_c := @getchar do {
  497.     if slashupto("'", token ||:= next_c, 2)
  498.     then {
  499.         next_c := @getchar
  500.         # Return & resume outermost containing loop in calling
  501.         # procedure w/ new next_c.
  502.         return TOK("CSETLIT", token)
  503.     }
  504.     }
  505.  
  506. end
  507.  
  508.  
  509. #
  510. #  do_digits:  coexpression -> TOK record
  511. #              getchar      -> t
  512. #
  513. #      Where getchar is the coexpression that produces the next char
  514. #      on the input stream, and where t is a TOK record containing
  515. #      either "REALLIT" or "INTLIT" in its sym field, and the text of
  516. #      the numeric literal in its str field.
  517. #
  518. procedure do_digits(getchar)
  519.  
  520.     local token, tok_record
  521.     # global next_c
  522.  
  523.     # Assume integer literal until proven otherwise....
  524.     tok_record := TOK("INTLIT")
  525.  
  526. #   write(&errout, "it's an integer or real literal")
  527.     token := ("0" ~== next_c) | ""
  528.     while (next_c := @getchar) == "0"
  529.     while any(&digits, next_c) do {
  530.     token ||:= next_c
  531.     next_c := @getchar
  532.     }
  533.     if token ||:= (next_c == ("R"|"r")) then {
  534.     while any(&digits, next_c := @getchar) do
  535.         token ||:= next_c
  536.     } else {
  537.     if token ||:= (next_c == ".") then {
  538.         while any(&digits, next_c := @getchar) do
  539.         token ||:= next_c
  540.         tok_record := TOK("REALLIT")
  541.     }
  542.     if token ||:= (next_c == ("e"|"E")) then {
  543.         while any(&digits, next_c := @getchar) do
  544.         token ||:= next_c
  545.         tok_record := TOK("REALLIT")
  546.     }
  547.     }
  548.     tok_record.str := ("" ~== token) | 0
  549.     return tok_record
  550.     
  551. end
  552.  
  553.  
  554. #
  555. #  do_whitespace:  coexpression x cset  -> &null
  556. #                  getchar x whitespace -> &null
  557. #
  558. #      Where getchar is the coexpression producing the next char on
  559. #      the input stream.  Do_whitespace just repeats until it finds a
  560. #      non-whitespace character, whitespace being defined as
  561. #      membership of a given character in the whitespace argument (a
  562. #      cset). 
  563. #
  564. procedure do_whitespace(getchar, whitespace)
  565.  
  566. #   write(&errout, "it's junk")
  567.     while any(whitespace, next_c) do
  568.     next_c := @getchar
  569.     return
  570.  
  571. end
  572.  
  573.  
  574. #
  575. #  do_identifier:  coexpression x table    -> TOK record
  576. #                  (getchar, reserved_tbl) -> t
  577. #
  578. #      Where getchar is the coexpression that pops off characters from
  579. #      the input stream, reserved_tbl is a table of reserved words
  580. #      (keys = the string values, values = the names qua symbols in
  581. #      the grammar), and t is a TOK record containing all subsequent
  582. #      letters, digits, or underscores after next_c (which must be a
  583. #      letter or underscore).  Note that next_c is global and gets
  584. #      reset by do_identifier.
  585. #
  586. procedure do_identifier(getchar, reserved_tbl)
  587.  
  588.     local token
  589.     # global next_c
  590.  
  591. #   write(&errout, "it's an indentifier")
  592.     token := next_c
  593.     while any(&letters ++ &digits ++ '_', next_c := @getchar)
  594.     do token ||:= next_c
  595.     return TOK(\reserved_tbl[token], token) | TOK("IDENT", token)
  596.     
  597. end
  598.  
  599.  
  600. #
  601. #  do_operator:  coexpression x list      -> TOK record
  602. #                getchar      x operators -> t
  603. #
  604. #      Where getchar is the coexpression that produces the next
  605. #      character on the input stream, and t is a TOK record
  606. #      describing the operator just scanned.  Calls recognop, which
  607. #      creates a DFSA to recognize valid Icon operators.  Arg2
  608. #      (operators) is the list of valid Icon operators formed by the
  609. #      calling procedure.
  610. #
  611. procedure do_operator(getchar, operators)
  612.  
  613.     local token, elem
  614.  
  615.     token := next_c
  616.  
  617.     # Go until recognop fails.
  618.     while elem := recognop(operators, token, 1) do
  619.     token ||:= (next_c := @getchar)
  620. #   write(&errout, ximage(elem))
  621.     if *\elem = 1 then
  622.     return TOK(elem[1][2], elem[1][1])
  623.     else fail
  624.  
  625. end
  626.  
  627.  
  628. record dfstn_state(b, e, tbl)
  629. record start_state(b, e, tbl, master_list)
  630.  
  631. procedure recognop(l, s, i)
  632.  
  633.     local   current_state, master_list
  634.     static  dfstn_table
  635.     initial dfstn_table := table()
  636.  
  637.     /i := 1
  638.     # See if we've created an automaton for l already.
  639.     /dfstn_table[l] := start_state(1, *l, &null, &null) & {
  640.     dfstn_table[l].master_list := sortf(l, i)
  641.     }
  642.  
  643.     current_state := dfstn_table[l]
  644.     # Save master_list, as current_state will change later on.
  645.     master_list   := current_state.master_list
  646.  
  647.     s ? {
  648.     while c := move(1) do {
  649.  
  650.         # Null means that this part of the automaton isn't
  651.         # complete.
  652.         #
  653.         if /current_state.tbl then
  654.         create_arcs(master_list, i, current_state, &pos)
  655.  
  656.         # If the table has been clobbered, then there are no arcs
  657.         # leading out of the current state.  Fail.
  658.         #
  659.         if current_state.tbl === 0 then
  660.         fail
  661.         
  662. #        write(&errout, "c = ", image(c))
  663. #        write(&errout, "table for current state = ", 
  664. #          ximage(current_state.tbl))
  665.  
  666.         # If we get to here, the current state has arcs leading
  667.         # out of it.  See if c is one of them.  If so, make the
  668.         # node to which arc c is connected the current state.
  669.         # Otherwise fail.
  670.         #
  671.         current_state := \current_state.tbl[c] | fail
  672.     }
  673.     }
  674.  
  675.     # Return possible completions.
  676.     #
  677.     result := list()
  678.     every j := current_state.b to current_state.e do {
  679.     if *master_list[j][i] = *s then
  680.         put(result, master_list[j])
  681.     }
  682.     # *result = 0 if nothing the right length is found
  683.     return result
  684.  
  685. end
  686.  
  687.  
  688. procedure create_arcs(master_list, field, current_state, POS)
  689.  
  690.     local elem, i, first_char, old_first_char
  691.  
  692.     current_state.tbl := table()
  693.     old_first_char := ""
  694.     
  695.     every elem := master_list[i := current_state.b to current_state.e][field]
  696.     do {
  697.     
  698.     # Get the first character for the current position (note that
  699.     # we're one character behind the calling routine; hence
  700.     # POS-1).
  701.     #
  702.     first_char := elem[POS-1] | next
  703.     
  704.     # If we have a new first character, create a new arc out of
  705.     # the current state.
  706.     #
  707.     if first_char ~== old_first_char then {
  708.         # Store the start position for the current character.
  709.         current_state.tbl[first_char] := dfstn_state(i)
  710.         # Store the end position for the old character.
  711.         (\current_state.tbl[old_first_char]).e := i-1
  712.         old_first_char := first_char
  713.     }
  714.     }
  715.     (\current_state.tbl[old_first_char]).e := i
  716.  
  717.     # Clobber table with 0 if no arcs were added.
  718.     current_state.tbl := (*current_state.tbl = 0)
  719.     return current_state
  720.  
  721. end
  722.  
  723.  
  724. #
  725. # slashupto:  cset x string x integer x integer -> integers
  726. #             (c, s, i, j) -> Is (a generator)
  727. #    where Is are the integer positions in s[i:j] before characters
  728. #    in c that is not preceded by a backslash escape
  729. #
  730. procedure slashupto(c, s, i, j)
  731.  
  732.     if /s := &subject
  733.     then /i := &pos
  734.     else /i := 1
  735.     /j := *s + 1
  736.     
  737.     /c := &cset
  738.     c ++:= '\\'
  739.     s[1:j] ? {
  740.         tab(i)
  741.         while tab(upto(c)) do {
  742.             if ="\\" then {
  743.         move(1)
  744.         next
  745.         }
  746.             suspend .&pos
  747.             move(1)
  748.         }
  749.     }
  750.  
  751. end
  752.  
  753.  
  754. -- 
  755.  
  756.    -Richard L. Goerwitz              goer%midway@uchicago.bitnet
  757.    goer@midway.uchicago.edu          rutgers!oddjob!ellis!goer
  758.